About

This is the analysis script for Facial examiners vs. super-recognizers: Evaluating behavior beyond accuracy. Code here can be used to replicate results and figures.

Code is available as-is for informational purposes with no intent to provide software support.

Corresponding author: Dr. Carina A. Hahn, carina.hahn@nist.gov

Requirements

Set working directory to Source File Location (referred to as HomeDir for explanation purposes). Source File location is the location of this analysis script.

If first time using, download required scripts from from Kilem L. Gwet, Ph.D. at https://www.agreestat.com/software/default.html (most recently accessed 03 November 2021)

weights.gen.r
agree.coeff2.r
agree.coeff3.dist.r
agree.coeff3.raw.r
paired t-test for agreement coefficients.r

Save in folder called Agree_coefficients within source file location:e.g., HomeDir/Agree_coefficients

Download the corresponding R script Facial_Examiners_vs_Super-recognizers_Imported_Functions.R for required functions and variable definitions.

Required R packages are shown in code.

Development and run conditions

Code was developed and run using RStudio on macOS. The analysis file is an R Markdown (.rmd) file. The .html document is its output.

The code was developed with R version 4.1.2 and RStudio version 2021.09.0. Executing the .rmd file will output the current version being run at the time of execution in the section Version and libraries.

For more information on RStudio and R Markdown, see https://www.rstudio.com and https://rmarkdown.rstudio.com. See [Running the script] for required scripts.

Disclaimer: Certain commercial equipment, instruments, or materials are identified in order to specify the procedures adequately. Such identification is not intended to imply recommendation or endorsement by NIST, nor is it intended to imply that the materials or equipment identified are necessarily the best available for the purpose.

Experimental procedure

Participants viewed 2 faces and rated their similarity. Subjects were asked to score the similarity (“Scores”) of 20 pairs of images on a scale of -3 to 3 (-3: the observations strongly support that it is not the ame person; +3: The observations strongly support that it is the same person). For each facial comparison, they provided their perceived difficulty rating (“Difficulty”) of their judgment on a scale of 1 to 5 (1. Easy: The comparison was easier than most facial comparisons; 5, Not Possible: The comparison was virtually impossible, due to a lack of detail in the image(s)).

12 of the trials were the same identity (mateBinary: 1); 8 were different identities (matebinary: 0)

See the paper for full experimental procedures.

Data

Obtaining

De-identified data can be obtained via data transfer agreement with the National Institute of Standards and Technology (NIST). Contact Dr. Carina Hahn at carina.hahn@nist.gov to obtain a data transfer agreement.

Column information and data coding

Images: image pair identifier
mateBinary: trial type identifier. 1= same identity pair; 0 = different identity pair
Difficulty: difficulty rating provided by participant
Group: participant group identifier. 1to1Face = facial examiner; Super = super-recognizer
Scores: identity judgment provided by participant
SubID: unique participant identifier

#Set working directory to Source File Location, then run
analysis.data<-readRDS("Hahnetal_examiners_super-recognizers.rds") #data can be obtained via data transfer agreement from NIST. See section 'Data' above

Number of participants

analysis.data %>%
  group_by(Group) %>%
  summarise(n.sub=n_distinct(SubID))

## # A tibble: 2 × 2
##   Group    n.sub
##   <fct>    <int>
## 1 1to1Face    57
## 2 Super       13

Identity judgment distributions

Histograms of the distribution of ratings Examiner and Super-recognizer groups. The histograms are separated by same-identity (Match) pairs and different-identity (Non-match) pairs. The histogram is computed over all ratings from all image-pairs for all members of a group.

Back to back histograms

backToBackHist.data<-analysis.data %>%
  group_by(Group,Scores,mateBinary) %>%
  summarise(n=n()) %>%
  group_by(Group,mateBinary) %>%
  mutate(prop.resp=n/sum(n)) %>%
  ungroup() %>%
  mutate(plotVal=ifelse(mateBinary==1,-1*prop.resp,prop.resp)) #allows symmetrical x-axis

## `summarise()` has grouped output by 'Group', 'Scores'. You can override using the `.groups` argument.

plot1.temp<-ggplot(backToBackHist.data[backToBackHist.data$Group=="1to1Face",],aes(Scores,plotVal,fill=fct_rev(as.factor(mateBinary)))) +
  geom_col(width=1,color="black")+
  scale_x_continuous(name="Identity judgment",breaks=seq(-3,3,1))+
  scale_y_continuous(name="Proportion",limits = c(-.4,.4),breaks = seq(-.4,.4,.2),labels=c("0.4","0.2","0.0","0.2","0.4"))+
  scale_fill_manual(breaks=c(1,0),limits=c(1,0),labels=c("Same ID","Different ID"),values = colorblind.blues,name="Trial Type") +
  labs(title="Facial Examiners") + 
  theme_classic() +
  theme(plot.title = element_text(hjust = 0.5),
        text=element_text(size=15),
        axis.text.x = element_text(size = 13),
        axis.text.y = element_text(size=13))+
  coord_flip()

plot2.temp<-ggplot(backToBackHist.data[backToBackHist.data$Group=="Super",],aes(Scores,plotVal,fill=fct_rev(as.factor(mateBinary)))) +
  geom_col(width=1,color="black")+
  scale_x_continuous(name="Identity judgment",breaks=seq(-3,3,1))+
  scale_y_continuous(name="Proportion",limits = c(-.4,.4),breaks = seq(-.4,.4,.2),labels=c("0.4","0.2","0.0","0.2","0.4"))+
  scale_fill_manual(breaks=c(1,0),limits=c(1,0),labels=c("Same ID","Different ID"),values = colorblind.blues,name="Trial Type")+
  labs(title="Super-recognizers",fill="Trial Type") + 
  theme_classic() +
  theme(plot.title = element_text(hjust = 0.5),text=element_text(size=15),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank()) +
  coord_flip()

ggarrange(plot1.temp,plot2.temp,common.legend = TRUE,legend = "bottom")

rm(plot1.temp,plot2.temp)

Statistical analysis and cumulative distribution plots

Two-sample Kolmogorov–Smirnov tests (KS test)

Facial examiners vs. Super-recognizers: Same-identity

analysis.data %>% 
  filter(mateBinary=="1") %>%
  with(.,ks.test(Scores[Group=="Super"],Scores[Group=="1to1Face"])) %>% 
  suppressWarnings()

## 
##  Asymptotic two-sample Kolmogorov-Smirnov test
## 
## data:  Scores[Group == "Super"] and Scores[Group == "1to1Face"]
## D = 0.16622, p-value = 0.001789
## alternative hypothesis: two-sided

analysis.data %>% 
  filter(mateBinary=="1") %>% 
  droplevels() %>% 
  ggplot(.,aes(x=Scores,color=Group,linetype=Group))+
  stat_ecdf(geom="line",size=1.3)+
  scale_x_continuous(name="Identity Judgment",breaks=seq(-3,3),labels=seq(-3,3))+
  scale_color_manual(values=c(brewer.pal(n = 7,name="Blues")[2],brewer.pal(n = 7,name="Blues")[7]),
                    limits=c("1to1Face","Super"),
                    label=c("Facial examiners","Super-rec."),
                    name="Group")+
  scale_linetype_manual(values=c("solid","dotted"),
                        limits=c("1to1Face","Super"),
                        label=c("Facial examiners","Super-rec."),
                        name="Group")+
  ggtitle("Same-identity trials")+
  labs(y="Cumulative Proportion")+
  theme_classic()+
  theme(plot.title = element_text(hjust = 0.5),
        axis.text.x = element_text(size=12),
        axis.title.x = element_text(size=14),
        axis.text.y = element_text(size=12),
        axis.title.y = element_text(size=14))

Facial examiners vs. Super-recognizers: Different-identity

analysis.data %>% 
  filter(mateBinary=="0") %>%
  with(.,ks.test(Scores[Group=="Super"],Scores[Group=="1to1Face"])) %>% 
  suppressWarnings()

## 
##  Asymptotic two-sample Kolmogorov-Smirnov test
## 
## data:  Scores[Group == "Super"] and Scores[Group == "1to1Face"]
## D = 0.2026, p-value = 0.001913
## alternative hypothesis: two-sided

analysis.data %>% 
  filter(mateBinary=="0") %>% 
  droplevels() %>% 
  ggplot(.,aes(x=Scores,color=Group,linetype=Group))+
  stat_ecdf(geom="line",size=1.3)+
  scale_x_continuous(name="Identity Judgment",breaks=seq(-3,3),labels=seq(-3,3))+
  scale_color_manual(values=c(brewer.pal(n = 7,name="Blues")[2],brewer.pal(n = 7,name="Blues")[7]),
                    limits=c("1to1Face","Super"),
                    label=c("Facial examiners","Super-rec."),
                    name="Group")+
  scale_linetype_manual(values=c("solid","dotted"),
                        limits=c("1to1Face","Super"),
                        label=c("Facial examiners","Super-rec."),
                        name="Group")+
  ggtitle("Different-identity trials")+
  labs(y="Cumulative Proportion")+
  theme_classic()+
  theme(plot.title = element_text(hjust = 0.5),
        axis.text.x = element_text(size=12),
        axis.title.x = element_text(size=14),
        axis.text.y = element_text(size=12),
        axis.title.y = element_text(size=14))

Facial examiners: Same- vs. Different-identity

analysis.data %>% 
  filter(Group=="1to1Face") %>%
  with(.,ks.test(Scores[mateBinary=="1"],Scores[mateBinary=="0"]*-1)) %>%
  suppressWarnings()

## 
##  Asymptotic two-sample Kolmogorov-Smirnov test
## 
## data:  Scores[mateBinary == "1"] and Scores[mateBinary == "0"] * -1
## D = 0.038012, p-value = 0.8241
## alternative hypothesis: two-sided

analysis.data %>% 
  filter(Group=="1to1Face") %>%
  mutate(mirroredScores=case_when(mateBinary=="0" ~ Scores*-1,
                                  mateBinary=="1" ~ Scores)) %>%
  ggplot(.,aes(x=mirroredScores,color=mateBinary,linetype=mateBinary))+
  stat_ecdf(geom="line",size=1.3)+
  scale_x_continuous(name="Identity Judgment",breaks=seq(-3,3),labels=seq(-3,3))+
  scale_color_manual(values=c(brewer.pal(n = 7,name="Blues")[2],brewer.pal(n = 7,name="Blues")[7]),
                    limits=c("1","0"),
                    label=c("Same ID","Different ID (judgments mirrored)"),
                    name="Trial Type")+
  scale_linetype_manual(values=c("solid","dotted"),
                        limits=c("1","0"),
                        label=c("Same ID","Different ID (judgments mirrored)"),
                        name="Trial Type")+
  ggtitle("Facial examiners")+
  labs(y="Cumulative Proportion")+
  theme_classic()+
  theme(plot.title = element_text(hjust = 0.5),
        axis.text.x = element_text(size=12),
        axis.title.x = element_text(size=14),
        axis.text.y = element_text(size=12),
        axis.title.y = element_text(size=14))

Super-recognizer: Same- vs. Different-identity

analysis.data %>% 
  filter(Group=="Super") %>%
  with(.,ks.test(Scores[mateBinary=="1"],Scores[mateBinary=="0"]*-1)) %>%
  suppressWarnings()

## 
##  Asymptotic two-sample Kolmogorov-Smirnov test
## 
## data:  Scores[mateBinary == "1"] and Scores[mateBinary == "0"] * -1
## D = 0.1891, p-value = 0.02306
## alternative hypothesis: two-sided

analysis.data %>% 
  filter(Group=="Super") %>%
  mutate(mirroredScores=case_when(mateBinary=="0" ~ Scores*-1,
                                  mateBinary=="1" ~ Scores)) %>%
  ggplot(.,aes(x=mirroredScores,color=mateBinary,linetype=mateBinary))+
  stat_ecdf(geom="line",size=1.3)+
  scale_x_continuous(name="Identity Judgment",breaks=seq(-3,3),labels=seq(-3,3))+
  scale_color_manual(values=c(brewer.pal(n = 7,name="Blues")[2],brewer.pal(n = 7,name="Blues")[7]),
                    limits=c("1","0"),
                    label=c("Same ID","Different ID (judgments mirrored)"),
                    name="Trial Type")+
  scale_linetype_manual(values=c("solid","dotted"),
                        limits=c("1","0"),
                        label=c("Same ID","Different ID (judgments mirrored)"),
                        name="Trial Type")+
  ggtitle("Super-recognizers")+
  labs(y="Cumulative Proportion")+
  theme_classic()+
  theme(plot.title = element_text(hjust = 0.5),
        axis.text.x = element_text(size=12),
        axis.title.x = element_text(size=14),
        axis.text.y = element_text(size=12),
        axis.title.y = element_text(size=14))

Same- vs. Different-identity: Combined plot

plot1.temp<-analysis.data %>% 
  filter(Group=="1to1Face") %>%
  mutate(mirroredScores=case_when(mateBinary=="0" ~ Scores*-1,
                                  mateBinary=="1" ~ Scores)) %>%
  ggplot(.,aes(x=mirroredScores,color=mateBinary,linetype=mateBinary))+
  stat_ecdf(geom="line",size=1.3)+
  scale_x_continuous(name="Identity Judgment",breaks=seq(-3,3),labels=seq(-3,3))+
  scale_color_manual(values=c(brewer.pal(n = 7,name="Blues")[2],brewer.pal(n = 7,name="Blues")[7]),
                    limits=c("1","0"),
                    label=c("Same ID","Different ID (judgments mirrored)"),
                    name="Trial Type")+
  scale_linetype_manual(values=c("solid","dotted"),
                        limits=c("1","0"),
                        label=c("Same ID","Different ID (judgments mirrored)"),
                        name="Trial Type")+
  ggtitle("Facial examiners")+
  labs(y="Cumulative Proportion")+
  theme_classic()+
  theme(plot.title = element_text(hjust = 0.5),
        axis.text.x = element_text(size=12),
        axis.title.x = element_text(size=14),
        axis.text.y = element_text(size=12),
        axis.title.y = element_text(size=14))


plot2.temp<-
analysis.data %>% 
  filter(Group=="Super") %>%
  mutate(mirroredScores=case_when(mateBinary=="0" ~ Scores*-1,
                                  mateBinary=="1" ~ Scores)) %>%
  ggplot(.,aes(x=mirroredScores,color=mateBinary,linetype=mateBinary))+
  stat_ecdf(geom="line",size=1.3)+
  scale_x_continuous(name="Identity Judgment",breaks=seq(-3,3),labels=seq(-3,3))+
  scale_color_manual(values=c(brewer.pal(n = 7,name="Blues")[2],brewer.pal(n = 7,name="Blues")[7]),
                    limits=c("1","0"),
                    label=c("Same ID","Different ID (judgments mirrored)"),
                    name="Trial Type")+
  scale_linetype_manual(values=c("solid","dotted"),
                        limits=c("1","0"),
                        label=c("Same ID","Different ID (judgments mirrored)"),
                        name="Trial Type")+
  ggtitle("Super-recognizers")+
  labs(y="Cumulative Proportion")+
  theme_classic()+
  theme(plot.title = element_text(hjust = 0.5),
        axis.text.x = element_text(size=12),
        axis.title.x = element_text(size=14),
        axis.text.y = element_text(size=12),
        axis.title.y = element_text(size=14))

ggarrange(plot1.temp,plot2.temp,common.legend = TRUE,legend="bottom")

rm(plot1.temp,plot2.temp)

High and Low Confidence

The number of times highly confident ratings (+3 or -3) and midpoint ratings (0) were made across different participant groups. We computed the number of times a response of +/-3 was made for each participant. Separately, we computed the number of times a response of 0 was made for each participant. Each of these were divided by the total number of trials (20) for each participant. This is the reported proportion of responses.

A corresponding figure appears in supplemental materials of this script and the paper.

Descriptive statistics

analysis.data %>%
  group_by(SubID,Group,Scores) %>%
  tally() %>%
  spread(Scores,n) %>%
  replace(., is.na(.), 0) %>%
  group_by(SubID) %>%
  mutate(total3=sum(`-3`,`3`),
         totaln=sum(`-3`,`-2`,`-1`,`0`,`1`,`2`,`3`),
         proportion3=total3/totaln,
         proportion0=`0`/totaln) %>%
  group_by(Group) %>%
  summarise(mean3=mean(proportion3),
            sd3=sd(proportion3),
            mean0=mean(proportion0),
            sd0=sd(proportion0)) %>%
  kable(col.names = c("Group","Mean: +/-3","SD: +/-3","Mean: 0","SD: 0"),caption = "Mean judgments by group: high confidence and scale midpoint",digits=2) %>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

Mean judgments by group: high confidence and scale midpoint
Group	Mean: +/-3	SD: +/-3	Mean: 0	SD: 0
1to1Face	0.24	0.21	0.09	0.09
Super	0.40	0.25	0.01	0.02

Statistical analysis

Compare 1) the proportion of high confidence judgments between facial examiners and super-recognizers and 2) the proportion of midpoint judgments between facial examiners and super-recognizers. Note these are both collapsed across trial type.

Effect size: r statistic (e.g., pg. 123; Seigal & Castellan (1956) Nonparametric statistics for the behavioral sciences (2nd))

High confidence

analysis.data %>%
  group_by(SubID,Group,Scores) %>%
  tally() %>%
  spread(Scores,n) %>%
  replace(., is.na(.), 0) %>%
  group_by(SubID) %>%
  mutate(total3=sum(`-3`,`3`),
         totaln=sum(`-3`,`-2`,`-1`,`0`,`1`,`2`,`3`),
         proportion3=total3/totaln,
         proportion0=`0`/totaln) %>%
  ttestIS(formula = proportion3 ~ Group, data = .,mann = TRUE,effectSize = TRUE,ci=TRUE)

## 
##  INDEPENDENT SAMPLES T-TEST
## 
##  Independent Samples T-Test                                                                                          
##  ─────────────────────────────────────────────────────────────────────────────────────────────────────────────────── 
##                                     Statistic    df          p                                         Effect Size   
##  ─────────────────────────────────────────────────────────────────────────────────────────────────────────────────── 
##    proportion3    Student's t       -2.317828    68.00000    0.0234748    Cohen's d                     -0.7123955   
##                   Mann-Whitney U     232.0000                0.0364047    Rank biserial correlation      0.3738192   
##  ───────────────────────────────────────────────────────────────────────────────────────────────────────────────────

# Effect size
analysis.data %>%
  group_by(SubID,Group,Scores) %>%
  tally() %>%
  spread(Scores,n) %>%
  replace(., is.na(.), 0) %>%
  group_by(SubID) %>%
  mutate(total3=sum(`-3`,`3`),
         totaln=sum(`-3`,`-2`,`-1`,`0`,`1`,`2`,`3`),
         proportion3=total3/totaln,
         proportion0=`0`/totaln) %>%
  wilcoxonR(x=.$proportion3,g=.$Group)

##      r 
## -0.251

Midpoint (Low confidence)

analysis.data %>%
  group_by(SubID,Group,Scores) %>%
  tally() %>%
  spread(Scores,n) %>%
  replace(., is.na(.), 0) %>%
  group_by(SubID) %>%
  mutate(total3=sum(`-3`,`3`),
         totaln=sum(`-3`,`-2`,`-1`,`0`,`1`,`2`,`3`),
         proportion3=total3/totaln,
         proportion0=`0`/totaln) %>%
  ttestIS(formula = proportion0 ~ Group, data = .,mann = TRUE,effectSize = TRUE,ci=TRUE)

## 
##  INDEPENDENT SAMPLES T-TEST
## 
##  Independent Samples T-Test                                                                                          
##  ─────────────────────────────────────────────────────────────────────────────────────────────────────────────────── 
##                                     Statistic    df          p                                         Effect Size   
##  ─────────────────────────────────────────────────────────────────────────────────────────────────────────────────── 
##    proportion0    Student's t        2.961005    68.00000    0.0042195    Cohen's d                      0.9100790   
##                   Mann-Whitney U     177.5000                0.0019098    Rank biserial correlation      0.5209177   
##  ───────────────────────────────────────────────────────────────────────────────────────────────────────────────────

# Effect size
analysis.data %>%
  group_by(SubID,Group,Scores) %>%
  tally() %>%
  spread(Scores,n) %>%
  replace(., is.na(.), 0) %>%
  group_by(SubID) %>%
  mutate(total3=sum(`-3`,`3`),
         totaln=sum(`-3`,`-2`,`-1`,`0`,`1`,`2`,`3`),
         proportion3=total3/totaln,
         proportion0=`0`/totaln) %>%
  wilcoxonR(x=.$proportion0,g=.$Group)

##     r 
## 0.372

Plot

# Plot
plot1.temp<-analysis.data %>%
  group_by(SubID,Group,Scores) %>%
  tally() %>%
  spread(Scores,n) %>%
  replace(., is.na(.), 0) %>%
  group_by(SubID) %>%
  mutate(total3=sum(`-3`,`3`),
         totaln=sum(`-3`,`-2`,`-1`,`0`,`1`,`2`,`3`),
         proportion3=total3/totaln,
         proportion0=`0`/totaln) %>%
  ggplot(.,aes(x=Group,y=proportion3))+
  geom_dotplot(binaxis='y', stackdir='center', dotsize=.2,binwidth = 0.05,stackratio = 1,alpha=.5)+
  stat_summary(fun=mean, geom="point", size=5,shape=18,,color="blue")+ 
  stat_summary(fun=median, geom="point", size=5,shape=19,color="red")+
  ylim(0,1)+
  scale_x_discrete(breaks=c("1to1Face","Super"),label=c("Examiners","Super-rec."))+
  theme_minimal()+
  labs(fill="Trial Type",y="Proportion of judgments",title="High confidence ('+/-3') identity judgments")

plot2.temp<-analysis.data %>%
  group_by(SubID,Group,Scores) %>%
  tally() %>%
  spread(Scores,n) %>%
  replace(., is.na(.), 0) %>%
  group_by(SubID) %>%
  mutate(total3=sum(`-3`,`3`),
         totaln=sum(`-3`,`-2`,`-1`,`0`,`1`,`2`,`3`),
         proportion3=total3/totaln,
         proportion0=`0`/totaln) %>%
  ggplot(.,aes(x=Group,y=proportion0))+
  geom_dotplot(binaxis='y', stackdir='center', dotsize=.2,binwidth = 0.05,stackratio = 1,alpha=.5)+
  stat_summary(fun=mean, geom="point", size=5,shape=18,,color="blue")+ 
  stat_summary(fun=median, geom="point", size=5,shape=19,color="red")+
  ylim(0,1)+
  scale_x_discrete(breaks=c("1to1Face","Super"),label=c("Examiners","Super-rec."))+
  theme_minimal()+
  labs(fill="Trial Type",y="Proportion of judgments",title="Midpiont ('0') identity judgments")

ggarrange(plot1.temp,plot2.temp)

rm(plot1.temp,plot2.temp)

Identity judgment agreement

Inter-rater reliability is measured within participant groups with Fleiss’s Kappa (Gwent, Handbook of Inter-rater Reliability) to account for ordinal data. Instructions are available from: http://www.agreestat.com/software/r/new/readme_r_functions.pdf. Appendix B, page 10

Agreement was measured with Fleiss’s Weighted Kappa between two participants from the same group. Every possible pair was compared. Each unique combinations were created, with the number of combinations being restricted by the number of participants in the full participant group:

For 57 Examiners, there are 1,596 possible combinations. 1,596 unique groups were created.
For 13 super-recognizers, there are 78 possible combinations. 78 unique groups were created.

kappa.pairwise.examiners<-do.pairwise.kappa(analysis.data,'1to1Face')
kappa.pairwise.supers<-do.pairwise.kappa(analysis.data,'Super')

Descriptive statistics

kappa.pairwise.examiners %>%
  summarise(mean=mean(kappa.coeff),
            sd=sd(kappa.coeff)) %>%
  kable(caption = "Examiners: Mean and SD of pairwise Kappa",digits = 2) %>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

Examiners: Mean and SD of pairwise Kappa
mean	sd
0.48	0.24

kappa.pairwise.supers %>%
  summarise(mean=mean(kappa.coeff),
            sd=sd(kappa.coeff)) %>%
  kable(caption = "Super-rec.: Mean and SD of pairwise Kappa",digits = 2) %>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

Super-rec.: Mean and SD of pairwise Kappa
mean	sd
0.26	0.32

Plot

kappa.pairwise.examiners$group<-"examiner"
kappa.pairwise.supers$group<-"super"

ggplot(rbind(kappa.pairwise.examiners,kappa.pairwise.supers),aes(x=group,y=kappa.coeff))+
  geom_violin()+
  stat_boxplot(geom ='errorbar',width=.05,color="darkblue")+
  geom_boxplot(color="darkblue",width=.2)+
  stat_mean(color="red",size=4,pch=18)+
  scale_x_discrete(name="Group",limits=c("examiner","super"),labels=c("Examiners","Super-rec"))+
  labs(y=expression(hat(Kappa)*minute["c"]))+
  theme_classic() + 
  theme(axis.text.x = element_text(size = 13),
        axis.text.y = element_text(size=13),
        axis.title.x = element_text(size=15),
        axis.title.y = element_text(size=15))

Statistical analysis

To examine whether pairwise examiner agreement was different than super-recognizer pairwise agreement, a bootstrap procedure was executed.

Step 1: Randomly select from 20 images with replacement
2a: Compute pairwise agreement between all possible combinations of examiners
2b: Compute pairwise agreement between all possible combinations of super-recognizers
3a: Compute average agreement of examiners from 2a
3b: Compute average agreement of super-recognizers from 2b
4: Compute difference between to average agreement values from 3a and 3b -> save value from this iteration
5: Repeat 1-4 1000x

##
# DONE ONCE, OUTPUT SAVED, THEN COMMENTED OUT
#This makes future knitting much faster
#Code is retained for record keeping and reproduciblility
##

# ##initialize
# n.boot.iter<-1000
# pb <- progress_bar$new(total = n.boot.iter)
# kappa.diff<-matrix(NA,nrow = n.boot.iter)
# 
# #sum used here because only one value per score,image,ID. So sum = true score provided
# raters.matrix.examiners<-with(droplevels(analysis.data[analysis.data$Group=='1to1Face',]),tapply(Scores,list(Images,SubID),sum,check.names=FALSE))
# raters.matrix.super<-with(droplevels(analysis.data[analysis.data$Group=='Super',]),tapply(Scores,list(Images,SubID),sum,check.names=FALSE))
# 
# #get all possible combinations (non repeating) for examiners and super-recognizers separately
# pairs.labels.examiners<-combn(colnames(raters.matrix.examiners),2) %>%
#     t() %>%
#     as_tibble(.,.name_repair="universal") %>%
#     rename(SubID1=...1,SubID2=...2)
# 
# pairs.labels.super<-combn(colnames(raters.matrix.super),2) %>%
#     t() %>%
#     as_tibble(.,.name_repair="universal") %>%
#     rename(SubID1=...1,SubID2=...2)
# 
# ##Set seeds for each iteration - this was done once, saved to seeds_for_pairwise.rds, then commented out. Code itself is retained for record keeping. The rds output from this code is loaded at the beginning of this script. 
# #rand.select.seeds<-data.frame(iteration=1:n.boot.iter,seed=sample(1:10000,n.boot.iter , replace=T))
# #saveRDS(rand.select.seeds, "seeds_for_pairwise.rds")
# 
# for(i in 1:n.boot.iter){
#   set.seed(saved.seeds$seed[i]) #determines the seed for random sampling in next line
#   ind.imgs<-sample(20,replace = TRUE) #indices of selected images
# 
#   #get ratings for selected images
#   raters.examiner.ind<-data.frame(raters.matrix.examiners[ind.imgs,]) 
#   raters.super.ind<-data.frame(raters.matrix.super[ind.imgs,])
#   
#   #compute difference in agreement _for those selected images_
#   kappa.diff[i]<-do.pairwise.kappa.boot(raters.examiner.ind,raters.super.ind,pairs.labels.examiners,pairs.labels.super)
#   
#   pb$tick() #update progress bar
# }#end bootstrap loop
# 
# saveRDS(kappa.diff,file="bootstrapped_kappa_differences.rds")
#####DONE ABOVE. OUTPUT IS LOADED BELOW.
#This makes future knitting much faster

#Load. This .rds was produced using the code above. Doing once above then loading makes future knitting much faster
bootstrapped_kappa_differences<-readRDS("bootstrapped_kappa_differences.rds")
bootstrapped_kappa_differences<-as.data.frame(bootstrapped_kappa_differences)
colnames(bootstrapped_kappa_differences)<-"kappa.diff"

#Analysis
top.bottom.tail<-quantile(bootstrapped_kappa_differences$kappa.diff,probs=c(.025,.975))

ggplot(bootstrapped_kappa_differences,aes(x=kappa.diff))+ 
  geom_histogram(color="blue",fill="lightblue",bins = 50)+
  geom_vline(xintercept =top.bottom.tail[1],lty="dashed")+
  geom_vline(xintercept =top.bottom.tail[2],lty="dashed")+
  labs(x=expression("Difference in " *hat(Kappa)*minute["c"]),y="Frequency") +
  theme_classic()

print("Top and Bottom Tails")

## [1] "Top and Bottom Tails"

top.bottom.tail

##       2.5%      97.5% 
## 0.08322905 0.34891430

#Report whether or not statistically significant
if (top.bottom.tail[1]<=0){
  print("not significant")
} else {
  print("significant")
}

## [1] "significant"

Relationship between measures

Confidence vs. Difficulty

Trial level

The relationship between difficulty ratings and identity judgment (regardless of direction of the score +/-3). This was done at the level of the trial. This addresses the question: Is difficulty rating associated with absolute value of the score (confidence)? This was measured with Kendall’s tau.

Plot

plot1.temp<-analysis.data %>%
  filter(Group=="1to1Face") %>%
  mutate(mateBinary=as.factor(mateBinary),
         Difficulty=as.factor(Difficulty)) %>%
  ggplot(.,aes(y=Scores,x=Difficulty,color=fct_rev(mateBinary),shape=fct_rev(mateBinary)))+
  geom_point(position=position_jitter(h=0.15,w=0.15),alpha=.66)+
  scale_y_continuous(breaks=seq(-3,3,by=1))+
  scale_color_manual(values=c("orange","blue"),breaks=c("1","0"),labels=c("Same-ID","Different-ID"),name="Trial Type")+
  guides(color = guide_legend(override.aes = list(shape = c(19,17))))+
  scale_shape_discrete(guide="none")+
  ggtitle("Facial Examiners")+
  labs(x="Rated difficulty",y="Identity judgment")+
  theme_minimal()+
  theme(axis.text.x = element_text(size = 13),
        axis.text.y = element_text(size=13),
        axis.title.x = element_text(size=15),
        axis.title.y = element_text(size=15),
        plot.title = element_text(size=15,hjust = 0.5))

plot2.temp<-analysis.data %>%
  filter(Group=="Super") %>%
  mutate(mateBinary=as.factor(mateBinary),
         Difficulty=as.factor(Difficulty)) %>%
  ggplot(.,aes(y=Scores,x=Difficulty,color=fct_rev(mateBinary),shape=fct_rev(mateBinary)))+
  geom_point(position=position_jitter(h=0.15,w=0.15),alpha=.66)+
  scale_y_continuous(breaks=seq(-3,3,by=1))+
  scale_color_manual(values=c("orange","blue"),breaks=c("1","0"),labels=c("Same-ID","Different-ID"),name="Trial Type")+
  guides(color = guide_legend(override.aes = list(shape = c(19,17))))+
  scale_shape_discrete(guide="none")+
  ggtitle("Super-recognizers")+
  labs(x="Rated difficulty",y="Identity judgment")+
  theme_minimal()+
  theme(axis.text.x = element_text(size = 13),
        axis.text.y = element_text(size=13),
        axis.title.x = element_text(size=15),
        axis.title.y = element_text(size=15),
        plot.title = element_text(size=15,hjust = 0.5))

ggarrange(plot1.temp,plot2.temp,common.legend = TRUE,legend="bottom")

rm(plot1.temp,plot2.temp)

Statistical analysis

Compute kendall’s tau correlation between difficulty rating and absolute value of the identity judgments (confidence).

analysis.data %>%
  group_by(Group) %>% 
  summarise(tau=cor(Difficulty,abs(Scores),method = "kendall"),
            p=suppressWarnings(cor.test(Difficulty,abs(Scores),method = "kendall")[["p.value"]]))

## # A tibble: 2 × 3
##   Group       tau         p
##   <fct>     <dbl>     <dbl>
## 1 1to1Face -0.671 2.99e-159
## 2 Super    -0.762 4.35e- 43

Individual level

Compute mean confidence and mean difficulty per subject. Produce plot and compute Kendall’s tau correlation between the two.

Plot

analysis.data %>%
  group_by(Group,SubID) %>% 
  summarise(conf=mean(abs(Scores)),
            diff=mean(Difficulty)) %>%
  ggplot(.,aes(diff,conf,color=Group,shape=Group))+
  geom_point(size=3) +
  xlim(1,5)+
  ylim(0,3)+
  scale_color_manual(breaks=c("1to1Face","Super"),label=c("Examiners","Super-rec."),values=c(brewer.pal(n = 7,name = "Blues")[3],brewer.pal(n = 7,name = "Blues")[7]),guide="none")+
  guides(color = guide_legend(override.aes = list(shape = c(19,17))))+
  scale_shape_discrete(guide="none")+
  labs(y="Mean confidence",x="Mean rated difficulty")+
  theme_minimal()+
  theme(axis.text.x = element_text(size = 13),
        axis.text.y = element_text(size=13),
        axis.title.x = element_text(size=15),
        axis.title.y = element_text(size=15))

## `summarise()` has grouped output by 'Group'. You can override using the `.groups` argument.

Statistical analysis

analysis.data %>%
  group_by(Group,SubID) %>% 
  summarise(conf=mean(abs(Scores)),
            diff=mean(Difficulty)) %>%
  group_by(Group) %>%
  summarise(tau=cor(conf,diff,method = "kendall"),
            p=suppressWarnings(cor.test(conf,diff,method = "kendall")[["p.value"]]))

## `summarise()` has grouped output by 'Group'. You can override using the `.groups` argument.

## # A tibble: 2 × 3
##   Group       tau             p
##   <fct>     <dbl>         <dbl>
## 1 1to1Face -0.561 0.00000000183
## 2 Super    -0.701 0.000944

Confidence vs. Accuracy

Correlation (Kendall’s tau) between absolute value of responses (i.e., magnitude of decisions made) and AUC. The average confidence (average absolute value of response) was obtained per participant. The AUC was obtained per participant. Correlations were computed between the two, separately for examiners and super-recognizers.

Statistical analysis

analysis.data %>% 
  group_by(SubID,Group) %>% 
  summarise(conf=mean(abs(Scores)),
            auc=auc.w(Scores[mateBinary==1],Scores[mateBinary==0])) %>%
  group_by(Group) %>% 
  summarise(tau=cor(conf,auc,method = "kendall"),
            p.val=cor.test(conf,auc,method = "kendall")[["p.value"]]) %>% 
  kable(digits=3) %>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

## `summarise()` has grouped output by 'SubID'. You can override using the `.groups` argument.

Group	tau	p.val
1to1Face	0.291	0.002
Super	0.543	0.011

Difficulty vs. Accuracy

Correlation (Kendall’s tau) between rated difficulty and AUC. The average rated difficulty was obtained per participant. The AUC was obtained per participant. Correlations were computed between the two, separately for examiners and super-recognizers.

Difficulty rating scale:
1. Easy: The comparison was easier than most facial comparisons.
2. Moderate: The comparison was a typical facial comparison.
3. Difficult: The comparison was more difficult than most facial comparisons.
4. Very difficult: The comparison was unusually difficult, involving significant photometric illumination, or pose changes, other red flags.
5. Not Possible: The comparison was virtually impossible, due to a lack of detail in the image(s).

Statistical analysis

analysis.data %>% 
  group_by(SubID,Group) %>% 
  summarise(diff=mean(Difficulty),
            auc=auc.w(Scores[mateBinary==1],Scores[mateBinary==0])) %>%
  group_by(Group) %>% 
  summarise(tau=cor(diff,auc,method = "kendall"),
            p.val=cor.test(diff,auc,method = "kendall")[["p.value"]]) %>% 
  kable(digits=3) %>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

## `summarise()` has grouped output by 'SubID'. You can override using the `.groups` argument.

Group	tau	p.val
1to1Face	-0.216	0.020
Super	-0.484	0.023

Combined Confidence and Difficulty

Combined plot: The relationship between 1) confidence and accuracy, and 2) difficulty and accuracy

Plot

plot1.temp<-analysis.data %>% 
  group_by(SubID,Group) %>% 
  summarise(conf=mean(abs(Scores)),
            diff=mean(Difficulty),
            auc=auc.w(Scores[mateBinary==1],Scores[mateBinary==0])) %>%
  ggplot(.,aes(conf,auc,color=Group,shape=Group))+
  geom_point(size=3)+
  xlim(0,3)+
  ylim(.5,1)+
  scale_color_manual(breaks=c("1to1Face","Super"),label=c("Examiners","Super-rec."),values=c(brewer.pal(n = 7,name = "Blues")[3],brewer.pal(n = 7,name = "Blues")[7]),guide="none")+
  guides(color = guide_legend(override.aes = list(shape = c(19,17))))+
  scale_shape_discrete(guide="none")+
  labs(x="Mean confidence",y="AUC")+
  theme_minimal()+
  theme(axis.text.x = element_text(size = 13),
        axis.text.y = element_text(size=13),
        axis.title.x = element_text(size=15),
        axis.title.y = element_text(size=15))

## `summarise()` has grouped output by 'SubID'. You can override using the `.groups` argument.

plot2.temp<-analysis.data %>% 
  group_by(SubID,Group) %>% 
  summarise(conf=mean(abs(Scores)),
            diff=mean(Difficulty),
            auc=auc.w(Scores[mateBinary==1],Scores[mateBinary==0])) %>%
  ggplot(.,aes(diff,auc,color=Group,shape=Group))+
  geom_point(size=3)+
  ylim(.5,1)+
  xlim(1,5)+
  scale_color_manual(breaks=c("1to1Face","Super"),label=c("Examiners","Super-rec."),values=c(brewer.pal(n = 7,name = "Blues")[3],brewer.pal(n = 7,name = "Blues")[7]),guide=FALSE)+
  guides(color = guide_legend(override.aes = list(shape = c(19,17))))+
  scale_shape_discrete(guide=FALSE)+
  labs(x="Mean rated difficulty",y="AUC")+
  theme_minimal() +
  theme(axis.text.x = element_text(size = 13),
        axis.text.y = element_text(size=13),
        axis.title.x = element_text(size=15),
        axis.title.y = element_text(size=15))

## `summarise()` has grouped output by 'SubID'. You can override using the `.groups` argument.

ggarrange(plot1.temp,plot2.temp,common.legend = TRUE,legend="bottom")

rm(plot1.temp,plot2.temp)

Supplemental

Difficulty ratings

The graph below shows the back to back histogram for the distribution of difficulty ratings for each group.

Plot

backToBackHist.diff.data<-analysis.data %>%
  group_by(Group,Difficulty,mateBinary) %>%
  summarise(n=n()) %>%
  group_by(Group,mateBinary) %>%
  mutate(prop.resp=n/sum(n)) %>%
  ungroup() %>%
  mutate(plotVal=ifelse(mateBinary==1,-1*prop.resp,prop.resp))

## `summarise()` has grouped output by 'Group', 'Difficulty'. You can override using the `.groups` argument.

plot1.temp<-ggplot(backToBackHist.diff.data[backToBackHist.diff.data$Group=="1to1Face",],aes(Difficulty,plotVal,fill=fct_rev(as.factor(mateBinary)))) +
  geom_col(width=1,color="black")+
  scale_x_continuous(name="Difficulty rating",breaks=seq(1,5,1))+
  scale_y_continuous(name="Proportion",limits = c(-.5,.5),breaks = seq(-.5,.5,.2),labels=c("0.5","0.3","0.1","0.1","0.3","0.5"))+
  scale_fill_manual(breaks=c(1,0),limits=c(1,0),labels=c("Same ID","Different ID"),values = c(brewer.pal(n = 7,name="Blues")[2],brewer.pal(n = 7,name="Blues")[7]),name="Trial Type") +
  labs(title="Facial Examiners") + 
  theme_classic() +
  theme(plot.title = element_text(hjust = 0.5),
        text=element_text(size=15),
        axis.text.x = element_text(size = 13),
        axis.text.y = element_text(size=13))+
  coord_flip()

plot2.temp<-ggplot(backToBackHist.diff.data[backToBackHist.diff.data$Group=="Super",],aes(Difficulty,plotVal,fill=fct_rev(as.factor(mateBinary)))) +
  geom_col(width=1,color="black")+
  scale_x_continuous(name="Difficulty rating",breaks=seq(1,5,1))+
  scale_y_continuous(name="Proportion",limits = c(-.5,.5),breaks = seq(-.5,.5,.2),labels=c("0.5","0.3","0.1","0.1","0.3","0.5"))+
  scale_fill_manual(breaks=c(1,0),limits=c(1,0),labels=c("Same ID","Different ID"),values = c(brewer.pal(n = 7,name="Blues")[2],brewer.pal(n = 7,name="Blues")[7]),name="Trial Type") +
  labs(title="Super-recognizers") + 
  theme_classic() +
  theme(plot.title = element_text(hjust = 0.5),
        text=element_text(size=15),
        axis.text.x = element_text(size = 13),
        axis.text.y = element_text(size=13))+
  coord_flip()

ggarrange(plot1.temp,plot2.temp,common.legend = TRUE,legend = "bottom")

rm(plot1.temp,plot2.temp)

Statisical analysis: Distributions

Two-sample Kolmogorov–Smirnov tests (KS test)

Examiner vs. Super: Same-identity

with(analysis.data,suppressWarnings(ks.test(Difficulty[Group=="1to1Face" & mateBinary == "1"],Difficulty[Group=="Super" & mateBinary == "1"])))

## 
##  Asymptotic two-sample Kolmogorov-Smirnov test
## 
## data:  Difficulty[Group == "1to1Face" & mateBinary == "1"] and Difficulty[Group == "Super" & mateBinary == "1"]
## D = 0.23077, p-value = 2.662e-06
## alternative hypothesis: two-sided

Examiner vs. Super: Diffrent-identity

with(analysis.data,suppressWarnings(ks.test(Difficulty[Group=="1to1Face" & mateBinary == "0"],Difficulty[Group=="Super" & mateBinary == "0"])))

## 
##  Asymptotic two-sample Kolmogorov-Smirnov test
## 
## data:  Difficulty[Group == "1to1Face" & mateBinary == "0"] and Difficulty[Group == "Super" & mateBinary == "0"]
## D = 0.29352, p-value = 9.198e-07
## alternative hypothesis: two-sided

Examiner: Same- vs. Different-identity

with(analysis.data,suppressWarnings(ks.test(Difficulty[Group=="1to1Face" & mateBinary == "1"],Difficulty[Group=="1to1Face" & mateBinary == "0"])))

## 
##  Asymptotic two-sample Kolmogorov-Smirnov test
## 
## data:  Difficulty[Group == "1to1Face" & mateBinary == "1"] and Difficulty[Group == "1to1Face" & mateBinary == "0"]
## D = 0.052632, p-value = 0.4346
## alternative hypothesis: two-sided

Super-recognizer: Same- vs. Different-identity

with(analysis.data,suppressWarnings(ks.test(Difficulty[Group=="Super" & mateBinary == "1"],Difficulty[Group=="Super" & mateBinary == "0"])))

## 
##  Asymptotic two-sample Kolmogorov-Smirnov test
## 
## data:  Difficulty[Group == "Super" & mateBinary == "1"] and Difficulty[Group == "Super" & mateBinary == "0"]
## D = 0.11538, p-value = 0.3771
## alternative hypothesis: two-sided

Percent of each rating

This is the percent of trials in which a given difficulty rating was provided.

analysis.data %>%
  group_by(Group,Difficulty) %>%
  tally() %>%
  group_by(Group) %>%
  mutate(perc=n/sum(n)*100) %>%
  kable(digits = 2,col.names = c("Group","Difficulty","N judgments","Percent judgments"),caption = "Percent of difficulty ratings") %>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

Percent of difficulty ratings
Group	Difficulty	N judgments	Percent judgments
1to1Face	1	182	15.96
1to1Face	2	412	36.14
1to1Face	3	294	25.79
1to1Face	4	201	17.63
1to1Face	5	51	4.47
Super	1	96	36.92
Super	2	106	40.77
Super	3	46	17.69
Super	4	11	4.23
Super	5	1	0.38

Average difficulty ratings

Compute average difficulty ratings according to participant group and trial type (same or different-identity).

Tables and Plots

#Main effect group
analysis.data %>% 
  group_by(SubID,Group) %>% 
  summarise(diff=mean(Difficulty)) %>%
  group_by(Group) %>% 
  summarise(Mean=mean(diff),
            SD=sd(diff)) %>% 
  kable(digits = 2,caption = "Difficulty: Main effect of group") %>% 
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

## `summarise()` has grouped output by 'SubID'. You can override using the `.groups` argument.

Difficulty: Main effect of group
Group	Mean	SD
1to1Face	2.59	0.51
Super	1.90	0.38

#Main effect Trial Type
analysis.data %>% 
  group_by(SubID,mateBinary) %>% 
  summarise(diff=mean(Difficulty)) %>%
  group_by(mateBinary) %>% 
  summarise(Mean=mean(diff),
            SD=sd(diff)) %>% 
  kable(digits = 2,caption = "Difficulty: Main effect of trial type") %>% 
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

## `summarise()` has grouped output by 'SubID'. You can override using the `.groups` argument.

Difficulty: Main effect of trial type
mateBinary	Mean	SD
0	2.42	0.65
1	2.49	0.57

#Interaction: Group x Trial Type
analysis.data %>% 
  group_by(SubID,Group,mateBinary) %>% 
  summarise(diff=mean(Difficulty)) %>%
  group_by(Group,mateBinary) %>% 
  summarise(Mean=mean(diff),
            SD=sd(diff)) %>% 
  kable(digits = 2,caption = "Difficulty: Group x Trial Type") %>% 
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

## `summarise()` has grouped output by 'SubID', 'Group'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'Group'. You can override using the `.groups` argument.

Difficulty: Group x Trial Type
Group	mateBinary	Mean	SD
1to1Face	0	2.56	0.61
1to1Face	1	2.60	0.52
Super	0	1.80	0.39
Super	1	1.97	0.53

# Plot
analysis.data %>% 
  group_by(SubID,Group,mateBinary) %>% 
  summarise(diff=mean(Difficulty)) %>%
  ggplot(.,aes(x=Group,y=diff,fill=fct_rev(mateBinary)))+
  geom_dotplot(binaxis='y', stackdir='center', dotsize=.5,binwidth = 0.1,stackratio = 1,alpha=.7,position=position_dodge(0.8))+
  ylim(1,5)+
  stat_summary(fun=mean, geom="point", size=4,shape=23,position = position_dodge(.8))+
  scale_x_discrete(breaks=c("1to1Face","Super"),label=c("Examiners","Super-rec."))+
  scale_fill_manual(limits=c("1","0"),label=c("Same-ID","Different-ID"),values=c(brewer.pal(n = 7,name="Blues")[2],brewer.pal(n = 7,name="Blues")[7]))+
  labs(fill="Trial Type",y="Mean Difficulty")+
  theme_minimal()+
  theme(axis.text.x = element_text(size = 13),
        axis.text.y = element_text(size=13),
        axis.title.x = element_text(size=15),
        axis.title.y = element_text(size=15),
        plot.title = element_text(size=15,hjust = 0.5))

## `summarise()` has grouped output by 'SubID', 'Group'. You can override using the `.groups` argument.

Statistical analysis

ez.res<-ezANOVA(analysis.data,dv = Difficulty,wid = SubID,within = mateBinary,between = Group,type = 3,detailed = TRUE)
ez.res$ANOVA

##             Effect DFn DFd          SSn       SSd           F            p p<.05         ges
## 1      (Intercept)   1  68 422.38607940 33.142455 866.6302345 2.011664e-40     * 0.910762398
## 2            Group   1  68  10.20254765 33.142455  20.9330674 2.075315e-05     * 0.197768071
## 3       mateBinary   1  68   0.26336355  8.243444   2.1724804 1.451140e-01       0.006323367
## 4 Group:mateBinary   1  68   0.08876038  8.243444   0.7321825 3.951817e-01       0.002140111

# Get MSe and p_eta^2
main.group<-anova.supplemental(ez.res$ANOVA$DFn[2],ez.res$ANOVA$DFd[2],ez.res$ANOVA$SSn[2],ez.res$ANOVA$SSd[2])
main.trial<-anova.supplemental(ez.res$ANOVA$DFn[3],ez.res$ANOVA$DFd[3],ez.res$ANOVA$SSn[3],ez.res$ANOVA$SSd[3])
interaction.res<-anova.supplemental(ez.res$ANOVA$DFn[4],ez.res$ANOVA$DFd[4],ez.res$ANOVA$SSn[4],ez.res$ANOVA$SSd[4])

data.frame(Effect=c("Group","Trial.type","Interaction"),rbind(data.frame(main.group),data.frame(main.trial),data.frame(interaction.res))) %>% 
  kable(digits = 2,col.names = c("Effect","MSe","p_eta^2"),caption="ANOVA supplemental info") %>% 
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

ANOVA supplemental info
Effect	MSe	p_eta^2
Group	0.49	0.24
Trial.type	0.12	0.03
Interaction	0.12	0.01

License

NIST-developed software is provided by NIST as a public service. You may use, copy, and distribute copies of the software in any medium, provided that you keep intact this entire notice. You may improve, modify, and create derivative works of the software or any portion of the software, and you may copy and distribute such modifications or works. Modified works should carry a notice stating that you changed the software and should note the date and nature of any such change. Please explicitly acknowledge the National Institute of Standards and Technology as the source of the software.

NIST-developed software is expressly provided “AS IS.” NIST MAKES NO WARRANTY OF ANY KIND, EXPRESS, IMPLIED, IN FACT, OR ARISING BY OPERATION OF LAW, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, NON-INFRINGEMENT, AND DATA ACCURACY. NIST NEITHER REPRESENTS NOR WARRANTS THAT THE OPERATION OF THE SOFTWARE WILL BE UNINTERRUPTED OR ERROR-FREE, OR THAT ANY DEFECTS WILL BE CORRECTED. NIST DOES NOT WARRANT OR MAKE ANY REPRESENTATIONS REGARDING THE USE OF THE SOFTWARE OR THE RESULTS THEREOF, INCLUDING BUT NOT LIMITED TO THE CORRECTNESS, ACCURACY, RELIABILITY, OR USEFULNESS OF THE SOFTWARE.

You are solely responsible for determining the appropriateness of using and distributing the software and you assume all risks associated with its use, including but not limited to the risks and costs of program errors, compliance with applicable laws, damage to or loss of data, programs or equipment, and the unavailability or interruption of operation. This software is not intended to be used in any situation where a failure could cause risk of injury or damage to property. The software developed by NIST employees is not subject to copyright protection within the United States.

Version and libraries

Built with R version 4.2.0

Libraries:

loaded.libraries<-(.packages())
for (i in seq_along(loaded.libraries)) {
  get.cite<-citation(loaded.libraries[i])
  print(get.cite)
  }

## 
## To cite package 'progress' in publications use:
## 
##   Csárdi G, FitzJohn R (2019). _progress: Terminal Progress Bars_. R package version 1.2.2, <https://CRAN.R-project.org/package=progress>.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Manual{,
##     title = {progress: Terminal Progress Bars},
##     author = {Gábor Csárdi and Rich FitzJohn},
##     year = {2019},
##     note = {R package version 1.2.2},
##     url = {https://CRAN.R-project.org/package=progress},
##   }
## 
## ATTENTION: This citation information has been auto-generated from the package DESCRIPTION file and may need manual editing, see 'help("citation")'.
## 
## 
## 
## 
## To cite package 'R.utils' in publications use:
## 
##   Bengtsson H (2021). _R.utils: Various Programming Utilities_. R package version 2.11.0, <https://CRAN.R-project.org/package=R.utils>.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Manual{,
##     title = {R.utils: Various Programming Utilities},
##     author = {Henrik Bengtsson},
##     year = {2021},
##     note = {R package version 2.11.0},
##     url = {https://CRAN.R-project.org/package=R.utils},
##   }
## 
## 
## 
## 
## Please cite R.oo/R.methodsS3 as
## 
##   Bengtsson, H. The R.oo package - Object-Oriented Programming with References Using Standard R Code, Proceedings of the 3rd International Workshop on Distributed Statistical Computing (DSC 2003), ISSN 1609-395X, Hornik, K.; Leisch, F. & Zeileis, A. (ed.), 2003
## 
## A BibTeX entry for LaTeX users is
## 
##   @InProceedings{,
##     author = {Henrik Bengtsson},
##     title = {The {R.oo} package - Object-Oriented Programming with References Using Standard {R} Code},
##     booktitle = {Proceedings of the 3rd International Workshop on Distributed Statistical Computing (DSC 2003)},
##     year = {2003},
##     editor = {Kurt Hornik and Friedrich Leisch and Achim Zeileis},
##     address = {Vienna, Austria},
##     month = {March},
##     issn = {1609-395X},
##     url = {https://www.r-project.org/conferences/DSC-2003/Proceedings/Bengtsson.pdf},
##     howpublished = {https://www.r-project.org/conferences/DSC-2003/Proceedings/},
##   }
## 
## 
## Please cite R.oo/R.methodsS3 as
## 
##   Bengtsson, H. The R.oo package - Object-Oriented Programming with References Using Standard R Code, Proceedings of the 3rd International Workshop on Distributed Statistical Computing (DSC 2003), ISSN 1609-395X, Hornik, K.; Leisch, F. & Zeileis, A. (ed.), 2003
## 
## A BibTeX entry for LaTeX users is
## 
##   @InProceedings{,
##     author = {Henrik Bengtsson},
##     title = {The {R.oo} package - Object-Oriented Programming with References Using Standard {R} Code},
##     booktitle = {Proceedings of the 3rd International Workshop on Distributed Statistical Computing (DSC 2003)},
##     year = {2003},
##     editor = {Kurt Hornik and Friedrich Leisch and Achim Zeileis},
##     address = {Vienna, Austria},
##     month = {March},
##     issn = {1609-395X},
##     url = {https://www.r-project.org/conferences/DSC-2003/Proceedings/Bengtsson.pdf},
##     howpublished = {https://www.r-project.org/conferences/DSC-2003/Proceedings/},
##   }
## 
## 
## To cite package 'rcompanion' in publications use:
## 
##   Mangiafico S (2022). _rcompanion: Functions to Support Extension Education Program Evaluation_. R package version 2.4.15, <https://CRAN.R-project.org/package=rcompanion>.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Manual{,
##     title = {rcompanion: Functions to Support Extension Education Program Evaluation},
##     author = {Salvatore Mangiafico},
##     year = {2022},
##     note = {R package version 2.4.15},
##     url = {https://CRAN.R-project.org/package=rcompanion},
##   }
## 
## 
## 
## 
## To cite package 'jmv' in publications use:
## 
##   Selker R, Love J, Dropmann D, Moreno V (2022). _jmv: The 'jamovi' Analyses_. R package version 2.3.4, <https://CRAN.R-project.org/package=jmv>.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Manual{,
##     title = {jmv: The 'jamovi' Analyses},
##     author = {Ravi Selker and Jonathon Love and Damian Dropmann and Victor Moreno},
##     year = {2022},
##     note = {R package version 2.3.4},
##     url = {https://CRAN.R-project.org/package=jmv},
##   }
## 
## ATTENTION: This citation information has been auto-generated from the package DESCRIPTION file and may need manual editing, see 'help("citation")'.
## 
## 
## 
## 
## To cite package 'RColorBrewer' in publications use:
## 
##   Neuwirth E (2022). _RColorBrewer: ColorBrewer Palettes_. R package version 1.1-3, <https://CRAN.R-project.org/package=RColorBrewer>.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Manual{,
##     title = {RColorBrewer: ColorBrewer Palettes},
##     author = {Erich Neuwirth},
##     year = {2022},
##     note = {R package version 1.1-3},
##     url = {https://CRAN.R-project.org/package=RColorBrewer},
##   }
## 
## 
## 
## 
## To cite package 'ggpubr' in publications use:
## 
##   Kassambara A (2020). _ggpubr: 'ggplot2' Based Publication Ready Plots_. R package version 0.4.0, <https://CRAN.R-project.org/package=ggpubr>.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Manual{,
##     title = {ggpubr: 'ggplot2' Based Publication Ready Plots},
##     author = {Alboukadel Kassambara},
##     year = {2020},
##     note = {R package version 0.4.0},
##     url = {https://CRAN.R-project.org/package=ggpubr},
##   }
## 
## 
## 
## 
## To cite package 'ez' in publications use:
## 
##   Lawrence MA (2016). _ez: Easy Analysis and Visualization of Factorial Experiments_. R package version 4.4-0, <https://CRAN.R-project.org/package=ez>.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Manual{,
##     title = {ez: Easy Analysis and Visualization of Factorial Experiments},
##     author = {Michael A. Lawrence},
##     year = {2016},
##     note = {R package version 4.4-0},
##     url = {https://CRAN.R-project.org/package=ez},
##   }
## 
## ATTENTION: This citation information has been auto-generated from the package DESCRIPTION file and may need manual editing, see 'help("citation")'.
## 
## 
## 
## 
## To cite package 'kableExtra' in publications use:
## 
##   Zhu H (2021). _kableExtra: Construct Complex Table with 'kable' and Pipe Syntax_. R package version 1.3.4, <https://CRAN.R-project.org/package=kableExtra>.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Manual{,
##     title = {kableExtra: Construct Complex Table with 'kable' and Pipe Syntax},
##     author = {Hao Zhu},
##     year = {2021},
##     note = {R package version 1.3.4},
##     url = {https://CRAN.R-project.org/package=kableExtra},
##   }
## 
## 
## 
## 
## To cite the 'knitr' package in publications use:
## 
##   Yihui Xie (2022). knitr: A General-Purpose Package for Dynamic Report Generation in R. R package version 1.39.
## 
##   Yihui Xie (2015) Dynamic Documents with R and knitr. 2nd edition. Chapman and Hall/CRC. ISBN 978-1498716963
## 
##   Yihui Xie (2014) knitr: A Comprehensive Tool for Reproducible Research in R. In Victoria Stodden, Friedrich Leisch and Roger D. Peng, editors, Implementing Reproducible Computational Research. Chapman and Hall/CRC. ISBN 978-1466561595
## 
## To see these entries in BibTeX format, use 'print(<citation>, bibtex=TRUE)', 'toBibtex(.)', or set 'options(citation.bibtex.max=999)'.
## 
## 
## To cite package 'forcats' in publications use:
## 
##   Wickham H (2021). _forcats: Tools for Working with Categorical Variables (Factors)_. R package version 0.5.1, <https://CRAN.R-project.org/package=forcats>.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Manual{,
##     title = {forcats: Tools for Working with Categorical Variables (Factors)},
##     author = {Hadley Wickham},
##     year = {2021},
##     note = {R package version 0.5.1},
##     url = {https://CRAN.R-project.org/package=forcats},
##   }
## 
## 
## 
## 
## To cite package 'stringr' in publications use:
## 
##   Wickham H (2019). _stringr: Simple, Consistent Wrappers for Common String Operations_. R package version 1.4.0, <https://CRAN.R-project.org/package=stringr>.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Manual{,
##     title = {stringr: Simple, Consistent Wrappers for Common String Operations},
##     author = {Hadley Wickham},
##     year = {2019},
##     note = {R package version 1.4.0},
##     url = {https://CRAN.R-project.org/package=stringr},
##   }
## 
## 
## 
## 
## To cite package 'dplyr' in publications use:
## 
##   Wickham H, François R, Henry L, Müller K (2022). _dplyr: A Grammar of Data Manipulation_. R package version 1.0.9, <https://CRAN.R-project.org/package=dplyr>.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Manual{,
##     title = {dplyr: A Grammar of Data Manipulation},
##     author = {Hadley Wickham and Romain François and Lionel Henry and Kirill Müller},
##     year = {2022},
##     note = {R package version 1.0.9},
##     url = {https://CRAN.R-project.org/package=dplyr},
##   }
## 
## 
## 
## 
## To cite package 'purrr' in publications use:
## 
##   Henry L, Wickham H (2020). _purrr: Functional Programming Tools_. R package version 0.3.4, <https://CRAN.R-project.org/package=purrr>.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Manual{,
##     title = {purrr: Functional Programming Tools},
##     author = {Lionel Henry and Hadley Wickham},
##     year = {2020},
##     note = {R package version 0.3.4},
##     url = {https://CRAN.R-project.org/package=purrr},
##   }
## 
## 
## 
## 
## To cite package 'readr' in publications use:
## 
##   Wickham H, Hester J, Bryan J (2022). _readr: Read Rectangular Text Data_. R package version 2.1.2, <https://CRAN.R-project.org/package=readr>.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Manual{,
##     title = {readr: Read Rectangular Text Data},
##     author = {Hadley Wickham and Jim Hester and Jennifer Bryan},
##     year = {2022},
##     note = {R package version 2.1.2},
##     url = {https://CRAN.R-project.org/package=readr},
##   }
## 
## 
## 
## 
## To cite package 'tidyr' in publications use:
## 
##   Wickham H, Girlich M (2022). _tidyr: Tidy Messy Data_. R package version 1.2.0, <https://CRAN.R-project.org/package=tidyr>.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Manual{,
##     title = {tidyr: Tidy Messy Data},
##     author = {Hadley Wickham and Maximilian Girlich},
##     year = {2022},
##     note = {R package version 1.2.0},
##     url = {https://CRAN.R-project.org/package=tidyr},
##   }
## 
## 
## 
## 
## To cite package 'tibble' in publications use:
## 
##   Müller K, Wickham H (2022). _tibble: Simple Data Frames_. R package version 3.1.7, <https://CRAN.R-project.org/package=tibble>.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Manual{,
##     title = {tibble: Simple Data Frames},
##     author = {Kirill Müller and Hadley Wickham},
##     year = {2022},
##     note = {R package version 3.1.7},
##     url = {https://CRAN.R-project.org/package=tibble},
##   }
## 
## 
## 
## 
## To cite ggplot2 in publications, please use:
## 
##   H. Wickham. ggplot2: Elegant Graphics for Data Analysis. Springer-Verlag New York, 2016.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Book{,
##     author = {Hadley Wickham},
##     title = {ggplot2: Elegant Graphics for Data Analysis},
##     publisher = {Springer-Verlag New York},
##     year = {2016},
##     isbn = {978-3-319-24277-4},
##     url = {https://ggplot2.tidyverse.org},
##   }
## 
## 
## To cite package 'tidyverse' in publications use:
## 
##   Wickham et al., (2019). Welcome to the tidyverse. Journal of Open Source Software, 4(43), 1686, https://doi.org/10.21105/joss.01686
## 
## A BibTeX entry for LaTeX users is
## 
##   @Article{,
##     title = {Welcome to the {tidyverse}},
##     author = {Hadley Wickham and Mara Averick and Jennifer Bryan and Winston Chang and Lucy D'Agostino McGowan and Romain François and Garrett Grolemund and Alex Hayes and Lionel Henry and Jim Hester and Max Kuhn and Thomas Lin Pedersen and Evan Miller and Stephan Milton Bache and Kirill Müller and Jeroen Ooms and David Robinson and Dana Paige Seidel and Vitalie Spinu and Kohske Takahashi and Davis Vaughan and Claus Wilke and Kara Woo and Hiroaki Yutani},
##     year = {2019},
##     journal = {Journal of Open Source Software},
##     volume = {4},
##     number = {43},
##     pages = {1686},
##     doi = {10.21105/joss.01686},
##   }
## 
## 
## The 'stats' package is part of R.  To cite R in publications use:
## 
##   R Core Team (2022). R: A language and environment for statistical computing. R Foundation for Statistical Computing, Vienna, Austria. URL https://www.R-project.org/.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Manual{,
##     title = {R: A Language and Environment for Statistical Computing},
##     author = {{R Core Team}},
##     organization = {R Foundation for Statistical Computing},
##     address = {Vienna, Austria},
##     year = {2022},
##     url = {https://www.R-project.org/},
##   }
## 
## We have invested a lot of time and effort in creating R, please cite it when using it for data analysis. See also 'citation("pkgname")' for citing R packages.
## 
## 
## The 'graphics' package is part of R.  To cite R in publications use:
## 
##   R Core Team (2022). R: A language and environment for statistical computing. R Foundation for Statistical Computing, Vienna, Austria. URL https://www.R-project.org/.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Manual{,
##     title = {R: A Language and Environment for Statistical Computing},
##     author = {{R Core Team}},
##     organization = {R Foundation for Statistical Computing},
##     address = {Vienna, Austria},
##     year = {2022},
##     url = {https://www.R-project.org/},
##   }
## 
## We have invested a lot of time and effort in creating R, please cite it when using it for data analysis. See also 'citation("pkgname")' for citing R packages.
## 
## 
## The 'grDevices' package is part of R.  To cite R in publications use:
## 
##   R Core Team (2022). R: A language and environment for statistical computing. R Foundation for Statistical Computing, Vienna, Austria. URL https://www.R-project.org/.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Manual{,
##     title = {R: A Language and Environment for Statistical Computing},
##     author = {{R Core Team}},
##     organization = {R Foundation for Statistical Computing},
##     address = {Vienna, Austria},
##     year = {2022},
##     url = {https://www.R-project.org/},
##   }
## 
## We have invested a lot of time and effort in creating R, please cite it when using it for data analysis. See also 'citation("pkgname")' for citing R packages.
## 
## 
## The 'utils' package is part of R.  To cite R in publications use:
## 
##   R Core Team (2022). R: A language and environment for statistical computing. R Foundation for Statistical Computing, Vienna, Austria. URL https://www.R-project.org/.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Manual{,
##     title = {R: A Language and Environment for Statistical Computing},
##     author = {{R Core Team}},
##     organization = {R Foundation for Statistical Computing},
##     address = {Vienna, Austria},
##     year = {2022},
##     url = {https://www.R-project.org/},
##   }
## 
## We have invested a lot of time and effort in creating R, please cite it when using it for data analysis. See also 'citation("pkgname")' for citing R packages.
## 
## 
## The 'datasets' package is part of R.  To cite R in publications use:
## 
##   R Core Team (2022). R: A language and environment for statistical computing. R Foundation for Statistical Computing, Vienna, Austria. URL https://www.R-project.org/.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Manual{,
##     title = {R: A Language and Environment for Statistical Computing},
##     author = {{R Core Team}},
##     organization = {R Foundation for Statistical Computing},
##     address = {Vienna, Austria},
##     year = {2022},
##     url = {https://www.R-project.org/},
##   }
## 
## We have invested a lot of time and effort in creating R, please cite it when using it for data analysis. See also 'citation("pkgname")' for citing R packages.
## 
## 
## The 'methods' package is part of R.  To cite R in publications use:
## 
##   R Core Team (2022). R: A language and environment for statistical computing. R Foundation for Statistical Computing, Vienna, Austria. URL https://www.R-project.org/.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Manual{,
##     title = {R: A Language and Environment for Statistical Computing},
##     author = {{R Core Team}},
##     organization = {R Foundation for Statistical Computing},
##     address = {Vienna, Austria},
##     year = {2022},
##     url = {https://www.R-project.org/},
##   }
## 
## We have invested a lot of time and effort in creating R, please cite it when using it for data analysis. See also 'citation("pkgname")' for citing R packages.
## 
## 
## To cite R in publications use:
## 
##   R Core Team (2022). R: A language and environment for statistical computing. R Foundation for Statistical Computing, Vienna, Austria. URL https://www.R-project.org/.
## 
## A BibTeX entry for LaTeX users is
## 
##   @Manual{,
##     title = {R: A Language and Environment for Statistical Computing},
##     author = {{R Core Team}},
##     organization = {R Foundation for Statistical Computing},
##     address = {Vienna, Austria},
##     year = {2022},
##     url = {https://www.R-project.org/},
##   }
## 
## We have invested a lot of time and effort in creating R, please cite it when using it for data analysis. See also 'citation("pkgname")' for citing R packages.

Forensic Facial Examiners vs Super-recognizers: Evaluating Behavior Beyond Accuracy

Corresponding author: Dr. Carina A. Hahn, National Institute of Standards and Technology

About

Requirements

Development and run conditions

Experimental procedure

Data

Obtaining

Column information and data coding

Number of participants

Identity judgment distributions

Back to back histograms

Statistical analysis and cumulative distribution plots

High and Low Confidence

Descriptive statistics

Statistical analysis

High confidence

Midpoint (Low confidence)

Plot

Identity judgment agreement

Descriptive statistics

Plot

Statistical analysis

Relationship between measures

Confidence vs. Difficulty

Trial level

Plot

Statistical analysis

Individual level

Plot

Statistical analysis

Confidence vs. Accuracy

Statistical analysis

Difficulty vs. Accuracy

Statistical analysis

Combined Confidence and Difficulty

Plot

Supplemental

Difficulty ratings

Plot

Statisical analysis: Distributions

Percent of each rating

Average difficulty ratings

Tables and Plots

Statistical analysis

License

Version and libraries